| import qualified Maybe import qualified Prelude
|
| data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b)
|
| instance (Eq a, Eq b) => Eq (FiniteMap b a) where
|
|
(==) | fm_1 fm_2 | = | sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2 |
|
|
| addToFM :: Ord b => FiniteMap b a -> b -> a -> FiniteMap b a
addToFM | fm key elt | = | addToFM_C (\old new ->new) fm key elt |
|
| addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a
addToFM_C | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | |
| | new_key < key | = |
mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
|
| | new_key > key | = |
mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
|
| | otherwise | = |
Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
|
| deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMax | (Branch key elt _ fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord b => FiniteMap b a -> FiniteMap b a
deleteMin | (Branch key elt _ EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap a b
|
| findMax :: FiniteMap a b -> (a,b)
findMax | (Branch key elt _ _ EmptyFM) | = | (key,elt) |
findMax | (Branch key elt _ _ fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap b a -> (b,a)
findMin | (Branch key elt _ EmptyFM _) | = | (key,elt) |
findMin | (Branch key elt _ fm_l _) | = | findMin fm_l |
|
| fmToList :: FiniteMap a b -> [(a,b)]
fmToList | fm | = | foldFM (\key elt rest ->(key,elt) : rest) [] fm |
|
| foldFM :: (c -> b -> a -> a) -> a -> FiniteMap c b -> a
foldFM | k z EmptyFM | = | z |
foldFM | k z (Branch key elt _ fm_l fm_r) | = | foldFM k (k key elt (foldFM k z fm_r)) fm_l |
|
| glueBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueBal | EmptyFM fm2 | = | fm2 |
glueBal | fm1 EmptyFM | = | fm1 |
glueBal | fm1 fm2 | |
| | sizeFM fm2 > sizeFM fm1 | = |
mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) |
|
| | otherwise | = |
mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 | where |
mid_elt1 | | = | (\(_,mid_elt1) ->mid_elt1) vv2 |
|
mid_elt2 | | = | (\(_,mid_elt2) ->mid_elt2) vv3 |
|
mid_key1 | | = | (\(mid_key1,_) ->mid_key1) vv2 |
|
mid_key2 | | = | (\(mid_key2,_) ->mid_key2) vv3 |
|
|
|
|
|
|
|
| glueVBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueVBal | EmptyFM fm2 | = | fm2 |
glueVBal | fm1 EmptyFM | = | fm1 |
glueVBal | fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r) |
|
| | otherwise | = |
|
|
|
| intersectFM_C :: Ord d => (b -> c -> a) -> FiniteMap d b -> FiniteMap d c -> FiniteMap d a
intersectFM_C | combiner fm1 EmptyFM | = | emptyFM |
intersectFM_C | combiner EmptyFM fm2 | = | emptyFM |
intersectFM_C | combiner fm1 (Branch split_key elt2 _ left right) | |
| | Maybe.isJust maybe_elt1 | = |
mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) |
|
| | otherwise | = |
glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) | where |
elt1 | | = | (\(Just elt1) ->elt1) vv1 |
|
gts | | = | splitGT fm1 split_key |
|
lts | | = | splitLT fm1 split_key |
|
maybe_elt1 | | = | lookupFM fm1 split_key |
|
|
|
|
|
|
| lookupFM :: Ord b => FiniteMap b a -> b -> Maybe a
lookupFM | EmptyFM key | = | Nothing |
lookupFM | (Branch key elt _ fm_l fm_r) key_to_find | |
| | key_to_find < key | = |
lookupFM fm_l key_to_find |
|
| | key_to_find > key | = |
lookupFM fm_r key_to_find |
|
| | otherwise | = |
|
|
|
| mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBalBranch | key elt fm_L fm_R | |
| | size_l + size_r < 2 | = |
mkBranch 1 key elt fm_L fm_R |
|
| | size_r > sIZE_RATIO * size_l | = |
case | fm_R of |
| Branch _ _ _ fm_rl fm_rr | |
| | sizeFM fm_rl < 2 * sizeFM fm_rr | -> |
|
| | otherwise | -> |
|
|
|
|
| | size_l > sIZE_RATIO * size_r | = |
case | fm_L of |
| Branch _ _ _ fm_ll fm_lr | |
| | sizeFM fm_lr < 2 * sizeFM fm_ll | -> |
|
| | otherwise | -> |
|
|
|
|
| | otherwise | = |
mkBranch 2 key elt fm_L fm_R | where |
double_L | fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
double_R | (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r) |
|
single_L | fm_l (Branch key_r elt_r _ fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr |
|
single_R | (Branch key_l elt_l _ fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r) |
|
|
|
|
|
|
|
| mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBranch | which key elt fm_l fm_r | = |
let |
result | | = | Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r |
|
|
in | result |
| where |
|
left_ok | | = |
case | fm_l of |
| EmptyFM | -> | True |
| Branch left_key _ _ _ _ | -> |
let |
biggest_left_key | | = | fst (findMax fm_l) |
|
|
in | biggest_left_key < key |
|
|
|
|
right_ok | | = |
case | fm_r of |
| EmptyFM | -> | True |
| Branch right_key _ _ _ _ | -> |
let |
smallest_right_key | | = | fst (findMin fm_r) |
|
|
in | key < smallest_right_key |
|
|
|
|
unbox :: Int -> Int
|
|
|
|
| mkVBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkVBalBranch | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch | key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r) |
|
| | otherwise | = |
mkBranch 13 key elt fm_l fm_r | where |
|
|
|
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap a b -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch _ _ size _ _) | = | size |
|
| splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a
splitGT | EmptyFM split_key | = | emptyFM |
splitGT | (Branch key elt _ fm_l fm_r) split_key | |
| | split_key > key | = |
|
| | split_key < key | = |
mkVBalBranch key elt (splitGT fm_l split_key) fm_r |
|
| | otherwise | = |
|
|
|
| splitLT :: Ord b => FiniteMap b a -> b -> FiniteMap b a
splitLT | EmptyFM split_key | = | emptyFM |
splitLT | (Branch key elt _ fm_l fm_r) split_key | |
| | split_key < key | = |
|
| | split_key > key | = |
mkVBalBranch key elt fm_l (splitLT fm_r split_key) |
|
| | otherwise | = |
|
|
|
| unitFM :: a -> b -> FiniteMap a b
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap b a = EmptyFM | Branch b a Int (FiniteMap b a) (FiniteMap b a)
|
| instance (Eq a, Eq b) => Eq (FiniteMap a b) where
|
|
(==) | fm_1 fm_2 | = | sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2 |
|
|
| addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b
addToFM_C | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | |
| | new_key < key | = |
mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
|
| | new_key > key | = |
mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
|
| | otherwise | = |
Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
|
| deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMax | (Branch key elt _ fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMin | (Branch key elt _ EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap b a
|
| findMax :: FiniteMap a b -> (a,b)
findMax | (Branch key elt _ _ EmptyFM) | = | (key,elt) |
findMax | (Branch key elt _ _ fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap b a -> (b,a)
findMin | (Branch key elt _ EmptyFM _) | = | (key,elt) |
findMin | (Branch key elt _ fm_l _) | = | findMin fm_l |
|
| fmToList :: FiniteMap a b -> [(a,b)]
fmToList | fm | = | foldFM fmToList0 [] fm |
|
|
fmToList0 | key elt rest | = | (key,elt) : rest |
|
| foldFM :: (a -> c -> b -> b) -> b -> FiniteMap a c -> b
foldFM | k z EmptyFM | = | z |
foldFM | k z (Branch key elt _ fm_l fm_r) | = | foldFM k (k key elt (foldFM k z fm_r)) fm_l |
|
| glueBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueBal | EmptyFM fm2 | = | fm2 |
glueBal | fm1 EmptyFM | = | fm1 |
glueBal | fm1 fm2 | |
| | sizeFM fm2 > sizeFM fm1 | = |
mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) |
|
| | otherwise | = |
mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 | where |
|
mid_elt10 | (_,mid_elt1) | = | mid_elt1 |
|
|
mid_elt20 | (_,mid_elt2) | = | mid_elt2 |
|
|
mid_key10 | (mid_key1,_) | = | mid_key1 |
|
|
mid_key20 | (mid_key2,_) | = | mid_key2 |
|
|
|
|
|
|
|
| glueVBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueVBal | EmptyFM fm2 | = | fm2 |
glueVBal | fm1 EmptyFM | = | fm1 |
glueVBal | fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r) |
|
| | otherwise | = |
|
|
|
| intersectFM_C :: Ord c => (a -> b -> d) -> FiniteMap c a -> FiniteMap c b -> FiniteMap c d
intersectFM_C | combiner fm1 EmptyFM | = | emptyFM |
intersectFM_C | combiner EmptyFM fm2 | = | emptyFM |
intersectFM_C | combiner fm1 (Branch split_key elt2 _ left right) | |
| | Maybe.isJust maybe_elt1 | = |
mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) |
|
| | otherwise | = |
glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) | where |
|
|
gts | | = | splitGT fm1 split_key |
|
lts | | = | splitLT fm1 split_key |
|
maybe_elt1 | | = | lookupFM fm1 split_key |
|
|
|
|
|
|
| lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b
lookupFM | EmptyFM key | = | Nothing |
lookupFM | (Branch key elt _ fm_l fm_r) key_to_find | |
| | key_to_find < key | = |
lookupFM fm_l key_to_find |
|
| | key_to_find > key | = |
lookupFM fm_r key_to_find |
|
| | otherwise | = |
|
|
|
| mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBalBranch | key elt fm_L fm_R | |
| | size_l + size_r < 2 | = |
mkBranch 1 key elt fm_L fm_R |
|
| | size_r > sIZE_RATIO * size_l | = |
case | fm_R of |
| Branch _ _ _ fm_rl fm_rr | |
| | sizeFM fm_rl < 2 * sizeFM fm_rr | -> |
|
| | otherwise | -> |
|
|
|
|
| | size_l > sIZE_RATIO * size_r | = |
case | fm_L of |
| Branch _ _ _ fm_ll fm_lr | |
| | sizeFM fm_lr < 2 * sizeFM fm_ll | -> |
|
| | otherwise | -> |
|
|
|
|
| | otherwise | = |
mkBranch 2 key elt fm_L fm_R | where |
double_L | fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
double_R | (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r) |
|
single_L | fm_l (Branch key_r elt_r _ fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr |
|
single_R | (Branch key_l elt_l _ fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r) |
|
|
|
|
|
|
|
| mkBranch :: Ord a => Int -> a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBranch | which key elt fm_l fm_r | = |
let |
result | | = | Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r |
|
|
in | result |
| where |
|
left_ok | | = |
case | fm_l of |
| EmptyFM | -> | True |
| Branch left_key _ _ _ _ | -> |
let |
biggest_left_key | | = | fst (findMax fm_l) |
|
|
in | biggest_left_key < key |
|
|
|
|
right_ok | | = |
case | fm_r of |
| EmptyFM | -> | True |
| Branch right_key _ _ _ _ | -> |
let |
smallest_right_key | | = | fst (findMin fm_r) |
|
|
in | key < smallest_right_key |
|
|
|
|
unbox :: Int -> Int
|
|
|
|
| mkVBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkVBalBranch | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch | key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r) |
|
| | otherwise | = |
mkBranch 13 key elt fm_l fm_r | where |
|
|
|
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap b a -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch _ _ size _ _) | = | size |
|
| splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a
splitGT | EmptyFM split_key | = | emptyFM |
splitGT | (Branch key elt _ fm_l fm_r) split_key | |
| | split_key > key | = |
|
| | split_key < key | = |
mkVBalBranch key elt (splitGT fm_l split_key) fm_r |
|
| | otherwise | = |
|
|
|
| splitLT :: Ord a => FiniteMap a b -> a -> FiniteMap a b
splitLT | EmptyFM split_key | = | emptyFM |
splitLT | (Branch key elt _ fm_l fm_r) split_key | |
| | split_key < key | = |
|
| | split_key > key | = |
mkVBalBranch key elt fm_l (splitLT fm_r split_key) |
|
| | otherwise | = |
|
|
|
| unitFM :: a -> b -> FiniteMap a b
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap b a = EmptyFM | Branch b a Int (FiniteMap b a) (FiniteMap b a)
|
| instance (Eq a, Eq b) => Eq (FiniteMap a b) where
|
|
(==) | fm_1 fm_2 | = | sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2 |
|
|
| addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a
addToFM_C | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | |
| | new_key < key | = |
mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
|
| | new_key > key | = |
mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
|
| | otherwise | = |
Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
|
| deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMax | (Branch key elt _ fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord b => FiniteMap b a -> FiniteMap b a
deleteMin | (Branch key elt _ EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap a b
|
| findMax :: FiniteMap a b -> (a,b)
findMax | (Branch key elt _ _ EmptyFM) | = | (key,elt) |
findMax | (Branch key elt _ _ fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap b a -> (b,a)
findMin | (Branch key elt _ EmptyFM _) | = | (key,elt) |
findMin | (Branch key elt _ fm_l _) | = | findMin fm_l |
|
| fmToList :: FiniteMap a b -> [(a,b)]
fmToList | fm | = | foldFM fmToList0 [] fm |
|
|
fmToList0 | key elt rest | = | (key,elt) : rest |
|
| foldFM :: (a -> c -> b -> b) -> b -> FiniteMap a c -> b
foldFM | k z EmptyFM | = | z |
foldFM | k z (Branch key elt _ fm_l fm_r) | = | foldFM k (k key elt (foldFM k z fm_r)) fm_l |
|
| glueBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueBal | EmptyFM fm2 | = | fm2 |
glueBal | fm1 EmptyFM | = | fm1 |
glueBal | fm1 fm2 | |
| | sizeFM fm2 > sizeFM fm1 | = |
mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) |
|
| | otherwise | = |
mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 | where |
|
mid_elt10 | (_,mid_elt1) | = | mid_elt1 |
|
|
mid_elt20 | (_,mid_elt2) | = | mid_elt2 |
|
|
mid_key10 | (mid_key1,_) | = | mid_key1 |
|
|
mid_key20 | (mid_key2,_) | = | mid_key2 |
|
|
|
|
|
|
|
| glueVBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueVBal | EmptyFM fm2 | = | fm2 |
glueVBal | fm1 EmptyFM | = | fm1 |
glueVBal | fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r) |
|
| | otherwise | = |
|
|
|
| intersectFM_C :: Ord c => (d -> b -> a) -> FiniteMap c d -> FiniteMap c b -> FiniteMap c a
intersectFM_C | combiner fm1 EmptyFM | = | emptyFM |
intersectFM_C | combiner EmptyFM fm2 | = | emptyFM |
intersectFM_C | combiner fm1 (Branch split_key elt2 _ left right) | |
| | Maybe.isJust maybe_elt1 | = |
mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) |
|
| | otherwise | = |
glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) | where |
|
|
gts | | = | splitGT fm1 split_key |
|
lts | | = | splitLT fm1 split_key |
|
maybe_elt1 | | = | lookupFM fm1 split_key |
|
|
|
|
|
|
| lookupFM :: Ord b => FiniteMap b a -> b -> Maybe a
lookupFM | EmptyFM key | = | Nothing |
lookupFM | (Branch key elt _ fm_l fm_r) key_to_find | |
| | key_to_find < key | = |
lookupFM fm_l key_to_find |
|
| | key_to_find > key | = |
lookupFM fm_r key_to_find |
|
| | otherwise | = |
|
|
|
| mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBalBranch | key elt fm_L fm_R | |
| | size_l + size_r < 2 | = |
mkBranch 1 key elt fm_L fm_R |
|
| | size_r > sIZE_RATIO * size_l | = |
mkBalBranch0 fm_L fm_R fm_R |
|
| | size_l > sIZE_RATIO * size_r | = |
mkBalBranch1 fm_L fm_R fm_L |
|
| | otherwise | = |
mkBranch 2 key elt fm_L fm_R | where |
double_L | fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
double_R | (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r) |
|
mkBalBranch0 | fm_L fm_R (Branch _ _ _ fm_rl fm_rr) | |
| | sizeFM fm_rl < 2 * sizeFM fm_rr | = |
|
| | otherwise | = |
|
|
|
mkBalBranch1 | fm_L fm_R (Branch _ _ _ fm_ll fm_lr) | |
| | sizeFM fm_lr < 2 * sizeFM fm_ll | = |
|
| | otherwise | = |
|
|
|
single_L | fm_l (Branch key_r elt_r _ fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr |
|
single_R | (Branch key_l elt_l _ fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r) |
|
|
|
|
|
|
|
| mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBranch | which key elt fm_l fm_r | = |
let |
result | | = | Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r |
|
|
in | result |
| where |
|
left_ok | | = | left_ok0 fm_l key fm_l |
|
left_ok0 | fm_l key EmptyFM | = | True |
left_ok0 | fm_l key (Branch left_key _ _ _ _) | = |
let |
biggest_left_key | | = | fst (findMax fm_l) |
|
|
in | biggest_left_key < key |
|
|
|
right_ok | | = | right_ok0 fm_r key fm_r |
|
right_ok0 | fm_r key EmptyFM | = | True |
right_ok0 | fm_r key (Branch right_key _ _ _ _) | = |
let |
smallest_right_key | | = | fst (findMin fm_r) |
|
|
in | key < smallest_right_key |
|
|
|
unbox :: Int -> Int
|
|
|
|
| mkVBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkVBalBranch | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch | key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r) |
|
| | otherwise | = |
mkBranch 13 key elt fm_l fm_r | where |
|
|
|
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap b a -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch _ _ size _ _) | = | size |
|
| splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a
splitGT | EmptyFM split_key | = | emptyFM |
splitGT | (Branch key elt _ fm_l fm_r) split_key | |
| | split_key > key | = |
|
| | split_key < key | = |
mkVBalBranch key elt (splitGT fm_l split_key) fm_r |
|
| | otherwise | = |
|
|
|
| splitLT :: Ord b => FiniteMap b a -> b -> FiniteMap b a
splitLT | EmptyFM split_key | = | emptyFM |
splitLT | (Branch key elt _ fm_l fm_r) split_key | |
| | split_key < key | = |
|
| | split_key > key | = |
mkVBalBranch key elt fm_l (splitLT fm_r split_key) |
|
| | otherwise | = |
|
|
|
| unitFM :: b -> a -> FiniteMap b a
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap b a = EmptyFM | Branch b a Int (FiniteMap b a) (FiniteMap b a)
|
| instance (Eq a, Eq b) => Eq (FiniteMap b a) where
|
|
(==) | fm_1 fm_2 | = | sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2 |
|
|
| addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b
addToFM_C | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | |
| | new_key < key | = |
mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
|
| | new_key > key | = |
mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
|
| | otherwise | = |
Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
|
| deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMax | (Branch key elt _ fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMin | (Branch key elt _ EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt _ fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap a b
|
| findMax :: FiniteMap a b -> (a,b)
findMax | (Branch key elt _ _ EmptyFM) | = | (key,elt) |
findMax | (Branch key elt _ _ fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap b a -> (b,a)
findMin | (Branch key elt _ EmptyFM _) | = | (key,elt) |
findMin | (Branch key elt _ fm_l _) | = | findMin fm_l |
|
| fmToList :: FiniteMap a b -> [(a,b)]
fmToList | fm | = | foldFM fmToList0 [] fm |
|
|
fmToList0 | key elt rest | = | (key,elt) : rest |
|
| foldFM :: (c -> b -> a -> a) -> a -> FiniteMap c b -> a
foldFM | k z EmptyFM | = | z |
foldFM | k z (Branch key elt _ fm_l fm_r) | = | foldFM k (k key elt (foldFM k z fm_r)) fm_l |
|
| glueBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueBal | EmptyFM fm2 | = | fm2 |
glueBal | fm1 EmptyFM | = | fm1 |
glueBal | fm1 fm2 | |
| | sizeFM fm2 > sizeFM fm1 | = |
mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) |
|
| | otherwise | = |
mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 | where |
|
mid_elt10 | (_,mid_elt1) | = | mid_elt1 |
|
|
mid_elt20 | (_,mid_elt2) | = | mid_elt2 |
|
|
mid_key10 | (mid_key1,_) | = | mid_key1 |
|
|
mid_key20 | (mid_key2,_) | = | mid_key2 |
|
|
|
|
|
|
|
| glueVBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueVBal | EmptyFM fm2 | = | fm2 |
glueVBal | fm1 EmptyFM | = | fm1 |
glueVBal | fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r) |
|
| | otherwise | = |
|
|
|
| intersectFM_C :: Ord d => (a -> b -> c) -> FiniteMap d a -> FiniteMap d b -> FiniteMap d c
intersectFM_C | combiner fm1 EmptyFM | = | emptyFM |
intersectFM_C | combiner EmptyFM fm2 | = | emptyFM |
intersectFM_C | combiner fm1 (Branch split_key elt2 _ left right) | |
| | Maybe.isJust maybe_elt1 | = |
mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) |
|
| | otherwise | = |
glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) | where |
|
|
gts | | = | splitGT fm1 split_key |
|
lts | | = | splitLT fm1 split_key |
|
maybe_elt1 | | = | lookupFM fm1 split_key |
|
|
|
|
|
|
| lookupFM :: Ord b => FiniteMap b a -> b -> Maybe a
lookupFM | EmptyFM key | = | Nothing |
lookupFM | (Branch key elt _ fm_l fm_r) key_to_find | |
| | key_to_find < key | = |
lookupFM fm_l key_to_find |
|
| | key_to_find > key | = |
lookupFM fm_r key_to_find |
|
| | otherwise | = |
|
|
|
| mkBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBalBranch | key elt fm_L fm_R | |
| | size_l + size_r < 2 | = |
mkBranch 1 key elt fm_L fm_R |
|
| | size_r > sIZE_RATIO * size_l | = |
mkBalBranch0 fm_L fm_R fm_R |
|
| | size_l > sIZE_RATIO * size_r | = |
mkBalBranch1 fm_L fm_R fm_L |
|
| | otherwise | = |
mkBranch 2 key elt fm_L fm_R | where |
double_L | fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
double_R | (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r) |
|
mkBalBranch0 | fm_L fm_R (Branch _ _ _ fm_rl fm_rr) | |
| | sizeFM fm_rl < 2 * sizeFM fm_rr | = |
|
| | otherwise | = |
|
|
|
mkBalBranch1 | fm_L fm_R (Branch _ _ _ fm_ll fm_lr) | |
| | sizeFM fm_lr < 2 * sizeFM fm_ll | = |
|
| | otherwise | = |
|
|
|
single_L | fm_l (Branch key_r elt_r _ fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr |
|
single_R | (Branch key_l elt_l _ fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r) |
|
|
|
|
|
|
|
| mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBranch | which key elt fm_l fm_r | = |
let |
result | | = | Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r |
|
|
in | result |
| where |
|
left_ok | | = | left_ok0 fm_l key fm_l |
|
left_ok0 | fm_l key EmptyFM | = | True |
left_ok0 | fm_l key (Branch left_key _ _ _ _) | = |
let |
biggest_left_key | | = | fst (findMax fm_l) |
|
|
in | biggest_left_key < key |
|
|
|
right_ok | | = | right_ok0 fm_r key fm_r |
|
right_ok0 | fm_r key EmptyFM | = | True |
right_ok0 | fm_r key (Branch right_key _ _ _ _) | = |
let |
smallest_right_key | | = | fst (findMin fm_r) |
|
|
in | key < smallest_right_key |
|
|
|
unbox :: Int -> Int
|
|
|
|
| mkVBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkVBalBranch | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch | key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r) |
|
| | otherwise | = |
mkBranch 13 key elt fm_l fm_r | where |
|
|
|
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap b a -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch _ _ size _ _) | = | size |
|
| splitGT :: Ord a => FiniteMap a b -> a -> FiniteMap a b
splitGT | EmptyFM split_key | = | emptyFM |
splitGT | (Branch key elt _ fm_l fm_r) split_key | |
| | split_key > key | = |
|
| | split_key < key | = |
mkVBalBranch key elt (splitGT fm_l split_key) fm_r |
|
| | otherwise | = |
|
|
|
| splitLT :: Ord a => FiniteMap a b -> a -> FiniteMap a b
splitLT | EmptyFM split_key | = | emptyFM |
splitLT | (Branch key elt _ fm_l fm_r) split_key | |
| | split_key < key | = |
|
| | split_key > key | = |
mkVBalBranch key elt fm_l (splitLT fm_r split_key) |
|
| | otherwise | = |
|
|
|
| unitFM :: b -> a -> FiniteMap b a
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b)
|
| instance (Eq a, Eq b) => Eq (FiniteMap b a) where
|
|
(==) | fm_1 fm_2 | = | sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2 |
|
|
| addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b
addToFM_C | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | |
| | new_key < key | = |
mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
|
| | new_key > key | = |
mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
|
| | otherwise | = |
Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
|
| deleteMax :: Ord b => FiniteMap b a -> FiniteMap b a
deleteMax | (Branch key elt vwx fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt vwy fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord b => FiniteMap b a -> FiniteMap b a
deleteMin | (Branch key elt wuw EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt wux fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap b a
|
| findMax :: FiniteMap b a -> (b,a)
findMax | (Branch key elt vyz vzu EmptyFM) | = | (key,elt) |
findMax | (Branch key elt vzv vzw fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap a b -> (a,b)
findMin | (Branch key elt wz EmptyFM xu) | = | (key,elt) |
findMin | (Branch key elt xv fm_l xw) | = | findMin fm_l |
|
| fmToList :: FiniteMap a b -> [(a,b)]
fmToList | fm | = | foldFM fmToList0 [] fm |
|
|
fmToList0 | key elt rest | = | (key,elt) : rest |
|
| foldFM :: (b -> a -> c -> c) -> c -> FiniteMap b a -> c
foldFM | k z EmptyFM | = | z |
foldFM | k z (Branch key elt wy fm_l fm_r) | = | foldFM k (k key elt (foldFM k z fm_r)) fm_l |
|
| glueBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueBal | EmptyFM fm2 | = | fm2 |
glueBal | fm1 EmptyFM | = | fm1 |
glueBal | fm1 fm2 | |
| | sizeFM fm2 > sizeFM fm1 | = |
mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) |
|
| | otherwise | = |
mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 | where |
|
mid_elt10 | (vzx,mid_elt1) | = | mid_elt1 |
|
|
mid_elt20 | (vzy,mid_elt2) | = | mid_elt2 |
|
|
mid_key10 | (mid_key1,vzz) | = | mid_key1 |
|
|
mid_key20 | (mid_key2,wuu) | = | mid_key2 |
|
|
|
|
|
|
|
| glueVBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueVBal | EmptyFM fm2 | = | fm2 |
glueVBal | fm1 EmptyFM | = | fm1 |
glueVBal | (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch zy zz (glueVBal (Branch yy yz zu zv zw) vuv) vuw |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch yy yz zv (glueVBal zw (Branch zy zz vuu vuv vuw)) |
|
| | otherwise | = |
glueBal (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) | where |
size_l | | = | sizeFM (Branch yy yz zu zv zw) |
|
size_r | | = | sizeFM (Branch zy zz vuu vuv vuw) |
|
|
|
|
|
| intersectFM_C :: Ord b => (c -> a -> d) -> FiniteMap b c -> FiniteMap b a -> FiniteMap b d
intersectFM_C | combiner fm1 EmptyFM | = | emptyFM |
intersectFM_C | combiner EmptyFM fm2 | = | emptyFM |
intersectFM_C | combiner fm1 (Branch split_key elt2 wuy left right) | |
| | Maybe.isJust maybe_elt1 | = |
mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) |
|
| | otherwise | = |
glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) | where |
|
|
gts | | = | splitGT fm1 split_key |
|
lts | | = | splitLT fm1 split_key |
|
maybe_elt1 | | = | lookupFM fm1 split_key |
|
|
|
|
|
|
| lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b
lookupFM | EmptyFM key | = | Nothing |
lookupFM | (Branch key elt wuv fm_l fm_r) key_to_find | |
| | key_to_find < key | = |
lookupFM fm_l key_to_find |
|
| | key_to_find > key | = |
lookupFM fm_r key_to_find |
|
| | otherwise | = |
|
|
|
| mkBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBalBranch | key elt fm_L fm_R | |
| | size_l + size_r < 2 | = |
mkBranch 1 key elt fm_L fm_R |
|
| | size_r > sIZE_RATIO * size_l | = |
mkBalBranch0 fm_L fm_R fm_R |
|
| | size_l > sIZE_RATIO * size_r | = |
mkBalBranch1 fm_L fm_R fm_L |
|
| | otherwise | = |
mkBranch 2 key elt fm_L fm_R | where |
double_L | fm_l (Branch key_r elt_r vxz (Branch key_rl elt_rl vyu fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
double_R | (Branch key_l elt_l vxu fm_ll (Branch key_lr elt_lr vxv fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r) |
|
mkBalBranch0 | fm_L fm_R (Branch vyv vyw vyx fm_rl fm_rr) | |
| | sizeFM fm_rl < 2 * sizeFM fm_rr | = |
|
| | otherwise | = |
|
|
|
mkBalBranch1 | fm_L fm_R (Branch vxw vxx vxy fm_ll fm_lr) | |
| | sizeFM fm_lr < 2 * sizeFM fm_ll | = |
|
| | otherwise | = |
|
|
|
single_L | fm_l (Branch key_r elt_r vyy fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr |
|
single_R | (Branch key_l elt_l vwz fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r) |
|
|
|
|
|
|
|
| mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBranch | which key elt fm_l fm_r | = |
let |
result | | = | Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r |
|
|
in | result |
| where |
|
left_ok | | = | left_ok0 fm_l key fm_l |
|
left_ok0 | fm_l key EmptyFM | = | True |
left_ok0 | fm_l key (Branch left_key vw vx vy vz) | = |
let |
biggest_left_key | | = | fst (findMax fm_l) |
|
|
in | biggest_left_key < key |
|
|
|
right_ok | | = | right_ok0 fm_r key fm_r |
|
right_ok0 | fm_r key EmptyFM | = | True |
right_ok0 | fm_r key (Branch right_key wu wv ww wx) | = |
let |
smallest_right_key | | = | fst (findMin fm_r) |
|
|
in | key < smallest_right_key |
|
|
|
unbox :: Int -> Int
|
|
|
|
| mkVBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkVBalBranch | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch | key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) | |
| | sIZE_RATIO * size_l < size_r | = |
mkBalBranch vvy vvz (mkVBalBranch key elt (Branch vuy vuz vvu vvv vvw) vwv) vww |
|
| | sIZE_RATIO * size_r < size_l | = |
mkBalBranch vuy vuz vvv (mkVBalBranch key elt vvw (Branch vvy vvz vwu vwv vww)) |
|
| | otherwise | = |
mkBranch 13 key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) | where |
size_l | | = | sizeFM (Branch vuy vuz vvu vvv vvw) |
|
size_r | | = | sizeFM (Branch vvy vvz vwu vwv vww) |
|
|
|
|
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap a b -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch xz yu size yv yw) | = | size |
|
| splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a
splitGT | EmptyFM split_key | = | emptyFM |
splitGT | (Branch key elt xy fm_l fm_r) split_key | |
| | split_key > key | = |
|
| | split_key < key | = |
mkVBalBranch key elt (splitGT fm_l split_key) fm_r |
|
| | otherwise | = |
|
|
|
| splitLT :: Ord b => FiniteMap b a -> b -> FiniteMap b a
splitLT | EmptyFM split_key | = | emptyFM |
splitLT | (Branch key elt xx fm_l fm_r) split_key | |
| | split_key < key | = |
|
| | split_key > key | = |
mkVBalBranch key elt fm_l (splitLT fm_r split_key) |
|
| | otherwise | = |
|
|
|
| unitFM :: b -> a -> FiniteMap b a
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap a b = EmptyFM | Branch a b Int (FiniteMap a b) (FiniteMap a b)
|
| instance (Eq a, Eq b) => Eq (FiniteMap b a) where
|
|
(==) | fm_1 fm_2 | = | sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2 |
|
|
| addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b
addToFM_C | combiner EmptyFM key elt | = | addToFM_C4 combiner EmptyFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | = | addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt |
|
|
addToFM_C0 | combiner key elt size fm_l fm_r new_key new_elt True | = | Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
addToFM_C1 | combiner key elt size fm_l fm_r new_key new_elt True | = | mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
addToFM_C1 | combiner key elt size fm_l fm_r new_key new_elt False | = | addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt otherwise |
|
|
addToFM_C2 | combiner key elt size fm_l fm_r new_key new_elt True | = | mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
addToFM_C2 | combiner key elt size fm_l fm_r new_key new_elt False | = | addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt (new_key > key) |
|
|
addToFM_C3 | combiner (Branch key elt size fm_l fm_r) new_key new_elt | = | addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt (new_key < key) |
|
|
addToFM_C4 | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C4 | xyz xzu xzv xzw | = | addToFM_C3 xyz xzu xzv xzw |
|
| deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMax | (Branch key elt vwx fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt vwy fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord b => FiniteMap b a -> FiniteMap b a
deleteMin | (Branch key elt wuw EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt wux fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap b a
|
| findMax :: FiniteMap b a -> (b,a)
findMax | (Branch key elt vyz vzu EmptyFM) | = | (key,elt) |
findMax | (Branch key elt vzv vzw fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap b a -> (b,a)
findMin | (Branch key elt wz EmptyFM xu) | = | (key,elt) |
findMin | (Branch key elt xv fm_l xw) | = | findMin fm_l |
|
| fmToList :: FiniteMap b a -> [(b,a)]
fmToList | fm | = | foldFM fmToList0 [] fm |
|
|
fmToList0 | key elt rest | = | (key,elt) : rest |
|
| foldFM :: (b -> a -> c -> c) -> c -> FiniteMap b a -> c
foldFM | k z EmptyFM | = | z |
foldFM | k z (Branch key elt wy fm_l fm_r) | = | foldFM k (k key elt (foldFM k z fm_r)) fm_l |
|
| glueBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueBal | EmptyFM fm2 | = | glueBal4 EmptyFM fm2 |
glueBal | fm1 EmptyFM | = | glueBal3 fm1 EmptyFM |
glueBal | fm1 fm2 | = | glueBal2 fm1 fm2 |
|
|
glueBal2 | fm1 fm2 | = |
glueBal1 fm1 fm2 (sizeFM fm2 > sizeFM fm1) | where |
glueBal0 | fm1 fm2 True | = | mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 |
|
glueBal1 | fm1 fm2 True | = | mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) |
glueBal1 | fm1 fm2 False | = | glueBal0 fm1 fm2 otherwise |
|
|
mid_elt10 | (vzx,mid_elt1) | = | mid_elt1 |
|
|
mid_elt20 | (vzy,mid_elt2) | = | mid_elt2 |
|
|
mid_key10 | (mid_key1,vzz) | = | mid_key1 |
|
|
mid_key20 | (mid_key2,wuu) | = | mid_key2 |
|
|
|
|
|
|
|
glueBal3 | fm1 EmptyFM | = | fm1 |
glueBal3 | xzy xzz | = | glueBal2 xzy xzz |
|
|
glueBal4 | EmptyFM fm2 | = | fm2 |
glueBal4 | yuv yuw | = | glueBal3 yuv yuw |
|
| glueVBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueVBal | EmptyFM fm2 | = | glueVBal5 EmptyFM fm2 |
glueVBal | fm1 EmptyFM | = | glueVBal4 fm1 EmptyFM |
glueVBal | (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) | = | glueVBal3 (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) |
|
|
glueVBal3 | (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) | = |
glueVBal2 yy yz zu zv zw zy zz vuu vuv vuw (sIZE_RATIO * size_l < size_r) | where |
glueVBal0 | yy yz zu zv zw zy zz vuu vuv vuw True | = | glueBal (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) |
|
glueVBal1 | yy yz zu zv zw zy zz vuu vuv vuw True | = | mkBalBranch yy yz zv (glueVBal zw (Branch zy zz vuu vuv vuw)) |
glueVBal1 | yy yz zu zv zw zy zz vuu vuv vuw False | = | glueVBal0 yy yz zu zv zw zy zz vuu vuv vuw otherwise |
|
glueVBal2 | yy yz zu zv zw zy zz vuu vuv vuw True | = | mkBalBranch zy zz (glueVBal (Branch yy yz zu zv zw) vuv) vuw |
glueVBal2 | yy yz zu zv zw zy zz vuu vuv vuw False | = | glueVBal1 yy yz zu zv zw zy zz vuu vuv vuw (sIZE_RATIO * size_r < size_l) |
|
size_l | | = | sizeFM (Branch yy yz zu zv zw) |
|
size_r | | = | sizeFM (Branch zy zz vuu vuv vuw) |
|
|
|
|
|
glueVBal4 | fm1 EmptyFM | = | fm1 |
glueVBal4 | xvw xvx | = | glueVBal3 xvw xvx |
|
|
glueVBal5 | EmptyFM fm2 | = | fm2 |
glueVBal5 | xvz xwu | = | glueVBal4 xvz xwu |
|
| intersectFM_C :: Ord b => (a -> c -> d) -> FiniteMap b a -> FiniteMap b c -> FiniteMap b d
intersectFM_C | combiner fm1 EmptyFM | = | intersectFM_C4 combiner fm1 EmptyFM |
intersectFM_C | combiner EmptyFM fm2 | = | intersectFM_C3 combiner EmptyFM fm2 |
intersectFM_C | combiner fm1 (Branch split_key elt2 wuy left right) | = | intersectFM_C2 combiner fm1 (Branch split_key elt2 wuy left right) |
|
|
intersectFM_C2 | combiner fm1 (Branch split_key elt2 wuy left right) | = |
intersectFM_C1 combiner fm1 split_key elt2 wuy left right (Maybe.isJust maybe_elt1) | where |
|
|
gts | | = | splitGT fm1 split_key |
|
intersectFM_C0 | combiner fm1 split_key elt2 wuy left right True | = | glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) |
|
intersectFM_C1 | combiner fm1 split_key elt2 wuy left right True | = | mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) |
intersectFM_C1 | combiner fm1 split_key elt2 wuy left right False | = | intersectFM_C0 combiner fm1 split_key elt2 wuy left right otherwise |
|
lts | | = | splitLT fm1 split_key |
|
maybe_elt1 | | = | lookupFM fm1 split_key |
|
|
|
|
|
|
intersectFM_C3 | combiner EmptyFM fm2 | = | emptyFM |
intersectFM_C3 | yvx yvy yvz | = | intersectFM_C2 yvx yvy yvz |
|
|
intersectFM_C4 | combiner fm1 EmptyFM | = | emptyFM |
intersectFM_C4 | ywv yww ywx | = | intersectFM_C3 ywv yww ywx |
|
| lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b
lookupFM | EmptyFM key | = | lookupFM4 EmptyFM key |
lookupFM | (Branch key elt wuv fm_l fm_r) key_to_find | = | lookupFM3 (Branch key elt wuv fm_l fm_r) key_to_find |
|
|
lookupFM0 | key elt wuv fm_l fm_r key_to_find True | = | Just elt |
|
|
lookupFM1 | key elt wuv fm_l fm_r key_to_find True | = | lookupFM fm_r key_to_find |
lookupFM1 | key elt wuv fm_l fm_r key_to_find False | = | lookupFM0 key elt wuv fm_l fm_r key_to_find otherwise |
|
|
lookupFM2 | key elt wuv fm_l fm_r key_to_find True | = | lookupFM fm_l key_to_find |
lookupFM2 | key elt wuv fm_l fm_r key_to_find False | = | lookupFM1 key elt wuv fm_l fm_r key_to_find (key_to_find > key) |
|
|
lookupFM3 | (Branch key elt wuv fm_l fm_r) key_to_find | = | lookupFM2 key elt wuv fm_l fm_r key_to_find (key_to_find < key) |
|
|
lookupFM4 | EmptyFM key | = | Nothing |
lookupFM4 | yuz yvu | = | lookupFM3 yuz yvu |
|
| mkBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBalBranch | key elt fm_L fm_R | = | mkBalBranch6 key elt fm_L fm_R |
|
|
mkBalBranch6 | key elt fm_L fm_R | = |
mkBalBranch5 key elt fm_L fm_R (size_l + size_r < 2) | where |
double_L | fm_l (Branch key_r elt_r vxz (Branch key_rl elt_rl vyu fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 key elt fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
double_R | (Branch key_l elt_l vxu fm_ll (Branch key_lr elt_lr vxv fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 key elt fm_lrr fm_r) |
|
mkBalBranch0 | fm_L fm_R (Branch vyv vyw vyx fm_rl fm_rr) | = | mkBalBranch02 fm_L fm_R (Branch vyv vyw vyx fm_rl fm_rr) |
|
mkBalBranch00 | fm_L fm_R vyv vyw vyx fm_rl fm_rr True | = | double_L fm_L fm_R |
|
mkBalBranch01 | fm_L fm_R vyv vyw vyx fm_rl fm_rr True | = | single_L fm_L fm_R |
mkBalBranch01 | fm_L fm_R vyv vyw vyx fm_rl fm_rr False | = | mkBalBranch00 fm_L fm_R vyv vyw vyx fm_rl fm_rr otherwise |
|
mkBalBranch02 | fm_L fm_R (Branch vyv vyw vyx fm_rl fm_rr) | = | mkBalBranch01 fm_L fm_R vyv vyw vyx fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr) |
|
mkBalBranch1 | fm_L fm_R (Branch vxw vxx vxy fm_ll fm_lr) | = | mkBalBranch12 fm_L fm_R (Branch vxw vxx vxy fm_ll fm_lr) |
|
mkBalBranch10 | fm_L fm_R vxw vxx vxy fm_ll fm_lr True | = | double_R fm_L fm_R |
|
mkBalBranch11 | fm_L fm_R vxw vxx vxy fm_ll fm_lr True | = | single_R fm_L fm_R |
mkBalBranch11 | fm_L fm_R vxw vxx vxy fm_ll fm_lr False | = | mkBalBranch10 fm_L fm_R vxw vxx vxy fm_ll fm_lr otherwise |
|
mkBalBranch12 | fm_L fm_R (Branch vxw vxx vxy fm_ll fm_lr) | = | mkBalBranch11 fm_L fm_R vxw vxx vxy fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll) |
|
mkBalBranch2 | key elt fm_L fm_R True | = | mkBranch 2 key elt fm_L fm_R |
|
mkBalBranch3 | key elt fm_L fm_R True | = | mkBalBranch1 fm_L fm_R fm_L |
mkBalBranch3 | key elt fm_L fm_R False | = | mkBalBranch2 key elt fm_L fm_R otherwise |
|
mkBalBranch4 | key elt fm_L fm_R True | = | mkBalBranch0 fm_L fm_R fm_R |
mkBalBranch4 | key elt fm_L fm_R False | = | mkBalBranch3 key elt fm_L fm_R (size_l > sIZE_RATIO * size_r) |
|
mkBalBranch5 | key elt fm_L fm_R True | = | mkBranch 1 key elt fm_L fm_R |
mkBalBranch5 | key elt fm_L fm_R False | = | mkBalBranch4 key elt fm_L fm_R (size_r > sIZE_RATIO * size_l) |
|
single_L | fm_l (Branch key_r elt_r vyy fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 key elt fm_l fm_rl) fm_rr |
|
single_R | (Branch key_l elt_l vwz fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 key elt fm_lr fm_r) |
|
|
|
|
|
|
| mkBranch :: Ord a => Int -> a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkBranch | which key elt fm_l fm_r | = |
let |
result | | = | Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r |
|
|
in | result |
| where |
|
left_ok | | = | left_ok0 fm_l key fm_l |
|
left_ok0 | fm_l key EmptyFM | = | True |
left_ok0 | fm_l key (Branch left_key vw vx vy vz) | = |
let |
biggest_left_key | | = | fst (findMax fm_l) |
|
|
in | biggest_left_key < key |
|
|
|
right_ok | | = | right_ok0 fm_r key fm_r |
|
right_ok0 | fm_r key EmptyFM | = | True |
right_ok0 | fm_r key (Branch right_key wu wv ww wx) | = |
let |
smallest_right_key | | = | fst (findMin fm_r) |
|
|
in | key < smallest_right_key |
|
|
|
unbox :: Int -> Int
|
|
|
|
| mkVBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkVBalBranch | key elt EmptyFM fm_r | = | mkVBalBranch5 key elt EmptyFM fm_r |
mkVBalBranch | key elt fm_l EmptyFM | = | mkVBalBranch4 key elt fm_l EmptyFM |
mkVBalBranch | key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) | = | mkVBalBranch3 key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) |
|
|
mkVBalBranch3 | key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) | = |
mkVBalBranch2 key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww (sIZE_RATIO * size_l < size_r) | where |
mkVBalBranch0 | key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww True | = | mkBranch 13 key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) |
|
mkVBalBranch1 | key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww True | = | mkBalBranch vuy vuz vvv (mkVBalBranch key elt vvw (Branch vvy vvz vwu vwv vww)) |
mkVBalBranch1 | key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww False | = | mkVBalBranch0 key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww otherwise |
|
mkVBalBranch2 | key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww True | = | mkBalBranch vvy vvz (mkVBalBranch key elt (Branch vuy vuz vvu vvv vvw) vwv) vww |
mkVBalBranch2 | key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww False | = | mkVBalBranch1 key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww (sIZE_RATIO * size_r < size_l) |
|
size_l | | = | sizeFM (Branch vuy vuz vvu vvv vvw) |
|
size_r | | = | sizeFM (Branch vvy vvz vwu vwv vww) |
|
|
|
|
|
mkVBalBranch4 | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch4 | xwy xwz xxu xxv | = | mkVBalBranch3 xwy xwz xxu xxv |
|
|
mkVBalBranch5 | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch5 | xxx xxy xxz xyu | = | mkVBalBranch4 xxx xxy xxz xyu |
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap b a -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch xz yu size yv yw) | = | size |
|
| splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a
splitGT | EmptyFM split_key | = | splitGT4 EmptyFM split_key |
splitGT | (Branch key elt xy fm_l fm_r) split_key | = | splitGT3 (Branch key elt xy fm_l fm_r) split_key |
|
|
splitGT0 | key elt xy fm_l fm_r split_key True | = | fm_r |
|
|
splitGT1 | key elt xy fm_l fm_r split_key True | = | mkVBalBranch key elt (splitGT fm_l split_key) fm_r |
splitGT1 | key elt xy fm_l fm_r split_key False | = | splitGT0 key elt xy fm_l fm_r split_key otherwise |
|
|
splitGT2 | key elt xy fm_l fm_r split_key True | = | splitGT fm_r split_key |
splitGT2 | key elt xy fm_l fm_r split_key False | = | splitGT1 key elt xy fm_l fm_r split_key (split_key < key) |
|
|
splitGT3 | (Branch key elt xy fm_l fm_r) split_key | = | splitGT2 key elt xy fm_l fm_r split_key (split_key > key) |
|
|
splitGT4 | EmptyFM split_key | = | emptyFM |
splitGT4 | xux xuy | = | splitGT3 xux xuy |
|
| splitLT :: Ord b => FiniteMap b a -> b -> FiniteMap b a
splitLT | EmptyFM split_key | = | splitLT4 EmptyFM split_key |
splitLT | (Branch key elt xx fm_l fm_r) split_key | = | splitLT3 (Branch key elt xx fm_l fm_r) split_key |
|
|
splitLT0 | key elt xx fm_l fm_r split_key True | = | fm_l |
|
|
splitLT1 | key elt xx fm_l fm_r split_key True | = | mkVBalBranch key elt fm_l (splitLT fm_r split_key) |
splitLT1 | key elt xx fm_l fm_r split_key False | = | splitLT0 key elt xx fm_l fm_r split_key otherwise |
|
|
splitLT2 | key elt xx fm_l fm_r split_key True | = | splitLT fm_l split_key |
splitLT2 | key elt xx fm_l fm_r split_key False | = | splitLT1 key elt xx fm_l fm_r split_key (split_key > key) |
|
|
splitLT3 | (Branch key elt xx fm_l fm_r) split_key | = | splitLT2 key elt xx fm_l fm_r split_key (split_key < key) |
|
|
splitLT4 | EmptyFM split_key | = | emptyFM |
splitLT4 | wzz xuu | = | splitLT3 wzz xuu |
|
| unitFM :: a -> b -> FiniteMap a b
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap b a = EmptyFM | Branch b a Int (FiniteMap b a) (FiniteMap b a)
|
| instance (Eq a, Eq b) => Eq (FiniteMap b a) where
|
|
(==) | fm_1 fm_2 | = | sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2 |
|
|
| addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord b => (a -> a -> a) -> FiniteMap b a -> b -> a -> FiniteMap b a
addToFM_C | combiner EmptyFM key elt | = | addToFM_C4 combiner EmptyFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | = | addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt |
|
|
addToFM_C0 | combiner key elt size fm_l fm_r new_key new_elt True | = | Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
addToFM_C1 | combiner key elt size fm_l fm_r new_key new_elt True | = | mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
addToFM_C1 | combiner key elt size fm_l fm_r new_key new_elt False | = | addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt otherwise |
|
|
addToFM_C2 | combiner key elt size fm_l fm_r new_key new_elt True | = | mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
addToFM_C2 | combiner key elt size fm_l fm_r new_key new_elt False | = | addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt (new_key > key) |
|
|
addToFM_C3 | combiner (Branch key elt size fm_l fm_r) new_key new_elt | = | addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt (new_key < key) |
|
|
addToFM_C4 | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C4 | xyz xzu xzv xzw | = | addToFM_C3 xyz xzu xzv xzw |
|
| deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMax | (Branch key elt vwx fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt vwy fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMin | (Branch key elt wuw EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt wux fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap b a
|
| findMax :: FiniteMap b a -> (b,a)
findMax | (Branch key elt vyz vzu EmptyFM) | = | (key,elt) |
findMax | (Branch key elt vzv vzw fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap a b -> (a,b)
findMin | (Branch key elt wz EmptyFM xu) | = | (key,elt) |
findMin | (Branch key elt xv fm_l xw) | = | findMin fm_l |
|
| fmToList :: FiniteMap b a -> [(b,a)]
fmToList | fm | = | foldFM fmToList0 [] fm |
|
|
fmToList0 | key elt rest | = | (key,elt) : rest |
|
| foldFM :: (a -> b -> c -> c) -> c -> FiniteMap a b -> c
foldFM | k z EmptyFM | = | z |
foldFM | k z (Branch key elt wy fm_l fm_r) | = | foldFM k (k key elt (foldFM k z fm_r)) fm_l |
|
| glueBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueBal | EmptyFM fm2 | = | glueBal4 EmptyFM fm2 |
glueBal | fm1 EmptyFM | = | glueBal3 fm1 EmptyFM |
glueBal | fm1 fm2 | = | glueBal2 fm1 fm2 |
|
|
glueBal2 | fm1 fm2 | = | glueBal2GlueBal1 fm1 fm2 fm1 fm2 (sizeFM fm2 > sizeFM fm1) |
|
|
glueBal2GlueBal0 | yzy yzz fm1 fm2 True | = | mkBalBranch (glueBal2Mid_key1 yzy yzz) (glueBal2Mid_elt1 yzy yzz) (deleteMax fm1) fm2 |
|
|
glueBal2GlueBal1 | yzy yzz fm1 fm2 True | = | mkBalBranch (glueBal2Mid_key2 yzy yzz) (glueBal2Mid_elt2 yzy yzz) fm1 (deleteMin fm2) |
glueBal2GlueBal1 | yzy yzz fm1 fm2 False | = | glueBal2GlueBal0 yzy yzz fm1 fm2 otherwise |
|
|
glueBal2Mid_elt1 | yzy yzz | = | glueBal2Mid_elt10 yzy yzz (glueBal2Vv2 yzy yzz) |
|
|
glueBal2Mid_elt10 | yzy yzz (vzx,mid_elt1) | = | mid_elt1 |
|
|
glueBal2Mid_elt2 | yzy yzz | = | glueBal2Mid_elt20 yzy yzz (glueBal2Vv3 yzy yzz) |
|
|
glueBal2Mid_elt20 | yzy yzz (vzy,mid_elt2) | = | mid_elt2 |
|
|
glueBal2Mid_key1 | yzy yzz | = | glueBal2Mid_key10 yzy yzz (glueBal2Vv2 yzy yzz) |
|
|
glueBal2Mid_key10 | yzy yzz (mid_key1,vzz) | = | mid_key1 |
|
|
glueBal2Mid_key2 | yzy yzz | = | glueBal2Mid_key20 yzy yzz (glueBal2Vv3 yzy yzz) |
|
|
glueBal2Mid_key20 | yzy yzz (mid_key2,wuu) | = | mid_key2 |
|
|
glueBal2Vv2 | yzy yzz | = | findMax yzy |
|
|
glueBal2Vv3 | yzy yzz | = | findMin yzz |
|
|
glueBal3 | fm1 EmptyFM | = | fm1 |
glueBal3 | xzy xzz | = | glueBal2 xzy xzz |
|
|
glueBal4 | EmptyFM fm2 | = | fm2 |
glueBal4 | yuv yuw | = | glueBal3 yuv yuw |
|
| glueVBal :: Ord b => FiniteMap b a -> FiniteMap b a -> FiniteMap b a
glueVBal | EmptyFM fm2 | = | glueVBal5 EmptyFM fm2 |
glueVBal | fm1 EmptyFM | = | glueVBal4 fm1 EmptyFM |
glueVBal | (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) | = | glueVBal3 (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) |
|
|
glueVBal3 | (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) | = | glueVBal3GlueVBal2 yy yz zu zv zw zy zz vuu vuv vuw yy yz zu zv zw zy zz vuu vuv vuw (sIZE_RATIO * glueVBal3Size_l yy yz zu zv zw zy zz vuu vuv vuw < glueVBal3Size_r yy yz zu zv zw zy zz vuu vuv vuw) |
|
|
glueVBal3GlueVBal0 | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw True | = | glueBal (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) |
|
|
glueVBal3GlueVBal1 | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw True | = | mkBalBranch yy yz zv (glueVBal zw (Branch zy zz vuu vuv vuw)) |
glueVBal3GlueVBal1 | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw False | = | glueVBal3GlueVBal0 zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw otherwise |
|
|
glueVBal3GlueVBal2 | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw True | = | mkBalBranch zy zz (glueVBal (Branch yy yz zu zv zw) vuv) vuw |
glueVBal3GlueVBal2 | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw False | = | glueVBal3GlueVBal1 zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw (sIZE_RATIO * glueVBal3Size_r zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv < glueVBal3Size_l zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv) |
|
|
glueVBal3Size_l | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv | = | sizeFM (Branch zuy zuz zvu zvv zvw) |
|
|
glueVBal3Size_r | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv | = | sizeFM (Branch zvx zvy zvz zwu zwv) |
|
|
glueVBal4 | fm1 EmptyFM | = | fm1 |
glueVBal4 | xvw xvx | = | glueVBal3 xvw xvx |
|
|
glueVBal5 | EmptyFM fm2 | = | fm2 |
glueVBal5 | xvz xwu | = | glueVBal4 xvz xwu |
|
| intersectFM_C :: Ord d => (a -> c -> b) -> FiniteMap d a -> FiniteMap d c -> FiniteMap d b
intersectFM_C | combiner fm1 EmptyFM | = | intersectFM_C4 combiner fm1 EmptyFM |
intersectFM_C | combiner EmptyFM fm2 | = | intersectFM_C3 combiner EmptyFM fm2 |
intersectFM_C | combiner fm1 (Branch split_key elt2 wuy left right) | = | intersectFM_C2 combiner fm1 (Branch split_key elt2 wuy left right) |
|
|
intersectFM_C2 | combiner fm1 (Branch split_key elt2 wuy left right) | = | intersectFM_C2IntersectFM_C1 fm1 split_key combiner fm1 split_key elt2 wuy left right (Maybe.isJust (intersectFM_C2Maybe_elt1 fm1 split_key)) |
|
|
intersectFM_C2Elt1 | yzw yzx | = | intersectFM_C2Elt10 yzw yzx (intersectFM_C2Vv1 yzw yzx) |
|
|
intersectFM_C2Elt10 | yzw yzx (Just elt1) | = | elt1 |
|
|
intersectFM_C2Gts | yzw yzx | = | splitGT yzw yzx |
|
|
intersectFM_C2IntersectFM_C0 | yzw yzx combiner fm1 split_key elt2 wuy left right True | = | glueVBal (intersectFM_C combiner (intersectFM_C2Lts yzw yzx) left) (intersectFM_C combiner (intersectFM_C2Gts yzw yzx) right) |
|
|
intersectFM_C2IntersectFM_C1 | yzw yzx combiner fm1 split_key elt2 wuy left right True | = | mkVBalBranch split_key (combiner (intersectFM_C2Elt1 yzw yzx) elt2) (intersectFM_C combiner (intersectFM_C2Lts yzw yzx) left) (intersectFM_C combiner (intersectFM_C2Gts yzw yzx) right) |
intersectFM_C2IntersectFM_C1 | yzw yzx combiner fm1 split_key elt2 wuy left right False | = | intersectFM_C2IntersectFM_C0 yzw yzx combiner fm1 split_key elt2 wuy left right otherwise |
|
|
intersectFM_C2Lts | yzw yzx | = | splitLT yzw yzx |
|
|
intersectFM_C2Maybe_elt1 | yzw yzx | = | lookupFM yzw yzx |
|
|
intersectFM_C2Vv1 | yzw yzx | = | intersectFM_C2Maybe_elt1 yzw yzx |
|
|
intersectFM_C3 | combiner EmptyFM fm2 | = | emptyFM |
intersectFM_C3 | yvx yvy yvz | = | intersectFM_C2 yvx yvy yvz |
|
|
intersectFM_C4 | combiner fm1 EmptyFM | = | emptyFM |
intersectFM_C4 | ywv yww ywx | = | intersectFM_C3 ywv yww ywx |
|
| lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b
lookupFM | EmptyFM key | = | lookupFM4 EmptyFM key |
lookupFM | (Branch key elt wuv fm_l fm_r) key_to_find | = | lookupFM3 (Branch key elt wuv fm_l fm_r) key_to_find |
|
|
lookupFM0 | key elt wuv fm_l fm_r key_to_find True | = | Just elt |
|
|
lookupFM1 | key elt wuv fm_l fm_r key_to_find True | = | lookupFM fm_r key_to_find |
lookupFM1 | key elt wuv fm_l fm_r key_to_find False | = | lookupFM0 key elt wuv fm_l fm_r key_to_find otherwise |
|
|
lookupFM2 | key elt wuv fm_l fm_r key_to_find True | = | lookupFM fm_l key_to_find |
lookupFM2 | key elt wuv fm_l fm_r key_to_find False | = | lookupFM1 key elt wuv fm_l fm_r key_to_find (key_to_find > key) |
|
|
lookupFM3 | (Branch key elt wuv fm_l fm_r) key_to_find | = | lookupFM2 key elt wuv fm_l fm_r key_to_find (key_to_find < key) |
|
|
lookupFM4 | EmptyFM key | = | Nothing |
lookupFM4 | yuz yvu | = | lookupFM3 yuz yvu |
|
| mkBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBalBranch | key elt fm_L fm_R | = | mkBalBranch6 key elt fm_L fm_R |
|
|
mkBalBranch6 | key elt fm_L fm_R | = | mkBalBranch6MkBalBranch5 key elt fm_L fm_R key elt fm_L fm_R (mkBalBranch6Size_l key elt fm_L fm_R + mkBalBranch6Size_r key elt fm_L fm_R < 2) |
|
|
mkBalBranch6Double_L | zuu zuv zuw zux fm_l (Branch key_r elt_r vxz (Branch key_rl elt_rl vyu fm_rll fm_rlr) fm_rr) | = | mkBranch 5 key_rl elt_rl (mkBranch 6 zuu zuv fm_l fm_rll) (mkBranch 7 key_r elt_r fm_rlr fm_rr) |
|
|
mkBalBranch6Double_R | zuu zuv zuw zux (Branch key_l elt_l vxu fm_ll (Branch key_lr elt_lr vxv fm_lrl fm_lrr)) fm_r | = | mkBranch 10 key_lr elt_lr (mkBranch 11 key_l elt_l fm_ll fm_lrl) (mkBranch 12 zuu zuv fm_lrr fm_r) |
|
|
mkBalBranch6MkBalBranch0 | zuu zuv zuw zux fm_L fm_R (Branch vyv vyw vyx fm_rl fm_rr) | = | mkBalBranch6MkBalBranch02 zuu zuv zuw zux fm_L fm_R (Branch vyv vyw vyx fm_rl fm_rr) |
|
|
mkBalBranch6MkBalBranch00 | zuu zuv zuw zux fm_L fm_R vyv vyw vyx fm_rl fm_rr True | = | mkBalBranch6Double_L zuu zuv zuw zux fm_L fm_R |
|
|
mkBalBranch6MkBalBranch01 | zuu zuv zuw zux fm_L fm_R vyv vyw vyx fm_rl fm_rr True | = | mkBalBranch6Single_L zuu zuv zuw zux fm_L fm_R |
mkBalBranch6MkBalBranch01 | zuu zuv zuw zux fm_L fm_R vyv vyw vyx fm_rl fm_rr False | = | mkBalBranch6MkBalBranch00 zuu zuv zuw zux fm_L fm_R vyv vyw vyx fm_rl fm_rr otherwise |
|
|
mkBalBranch6MkBalBranch02 | zuu zuv zuw zux fm_L fm_R (Branch vyv vyw vyx fm_rl fm_rr) | = | mkBalBranch6MkBalBranch01 zuu zuv zuw zux fm_L fm_R vyv vyw vyx fm_rl fm_rr (sizeFM fm_rl < 2 * sizeFM fm_rr) |
|
|
mkBalBranch6MkBalBranch1 | zuu zuv zuw zux fm_L fm_R (Branch vxw vxx vxy fm_ll fm_lr) | = | mkBalBranch6MkBalBranch12 zuu zuv zuw zux fm_L fm_R (Branch vxw vxx vxy fm_ll fm_lr) |
|
|
mkBalBranch6MkBalBranch10 | zuu zuv zuw zux fm_L fm_R vxw vxx vxy fm_ll fm_lr True | = | mkBalBranch6Double_R zuu zuv zuw zux fm_L fm_R |
|
|
mkBalBranch6MkBalBranch11 | zuu zuv zuw zux fm_L fm_R vxw vxx vxy fm_ll fm_lr True | = | mkBalBranch6Single_R zuu zuv zuw zux fm_L fm_R |
mkBalBranch6MkBalBranch11 | zuu zuv zuw zux fm_L fm_R vxw vxx vxy fm_ll fm_lr False | = | mkBalBranch6MkBalBranch10 zuu zuv zuw zux fm_L fm_R vxw vxx vxy fm_ll fm_lr otherwise |
|
|
mkBalBranch6MkBalBranch12 | zuu zuv zuw zux fm_L fm_R (Branch vxw vxx vxy fm_ll fm_lr) | = | mkBalBranch6MkBalBranch11 zuu zuv zuw zux fm_L fm_R vxw vxx vxy fm_ll fm_lr (sizeFM fm_lr < 2 * sizeFM fm_ll) |
|
|
mkBalBranch6MkBalBranch2 | zuu zuv zuw zux key elt fm_L fm_R True | = | mkBranch 2 key elt fm_L fm_R |
|
|
mkBalBranch6MkBalBranch3 | zuu zuv zuw zux key elt fm_L fm_R True | = | mkBalBranch6MkBalBranch1 zuu zuv zuw zux fm_L fm_R fm_L |
mkBalBranch6MkBalBranch3 | zuu zuv zuw zux key elt fm_L fm_R False | = | mkBalBranch6MkBalBranch2 zuu zuv zuw zux key elt fm_L fm_R otherwise |
|
|
mkBalBranch6MkBalBranch4 | zuu zuv zuw zux key elt fm_L fm_R True | = | mkBalBranch6MkBalBranch0 zuu zuv zuw zux fm_L fm_R fm_R |
mkBalBranch6MkBalBranch4 | zuu zuv zuw zux key elt fm_L fm_R False | = | mkBalBranch6MkBalBranch3 zuu zuv zuw zux key elt fm_L fm_R (mkBalBranch6Size_l zuu zuv zuw zux > sIZE_RATIO * mkBalBranch6Size_r zuu zuv zuw zux) |
|
|
mkBalBranch6MkBalBranch5 | zuu zuv zuw zux key elt fm_L fm_R True | = | mkBranch 1 key elt fm_L fm_R |
mkBalBranch6MkBalBranch5 | zuu zuv zuw zux key elt fm_L fm_R False | = | mkBalBranch6MkBalBranch4 zuu zuv zuw zux key elt fm_L fm_R (mkBalBranch6Size_r zuu zuv zuw zux > sIZE_RATIO * mkBalBranch6Size_l zuu zuv zuw zux) |
|
|
mkBalBranch6Single_L | zuu zuv zuw zux fm_l (Branch key_r elt_r vyy fm_rl fm_rr) | = | mkBranch 3 key_r elt_r (mkBranch 4 zuu zuv fm_l fm_rl) fm_rr |
|
|
mkBalBranch6Single_R | zuu zuv zuw zux (Branch key_l elt_l vwz fm_ll fm_lr) fm_r | = | mkBranch 8 key_l elt_l fm_ll (mkBranch 9 zuu zuv fm_lr fm_r) |
|
|
mkBalBranch6Size_l | zuu zuv zuw zux | = | sizeFM zuw |
|
|
mkBalBranch6Size_r | zuu zuv zuw zux | = | sizeFM zux |
|
| mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBranch | which key elt fm_l fm_r | = | mkBranchResult key elt fm_r fm_l |
|
|
mkBranchBalance_ok | zww zwx zwy | = | True |
|
|
mkBranchLeft_ok | zww zwx zwy | = | mkBranchLeft_ok0 zww zwx zwy zwy zwx zwy |
|
|
mkBranchLeft_ok0 | zww zwx zwy fm_l key EmptyFM | = | True |
mkBranchLeft_ok0 | zww zwx zwy fm_l key (Branch left_key vw vx vy vz) | = | mkBranchLeft_ok0Biggest_left_key fm_l < key |
|
|
mkBranchLeft_ok0Biggest_left_key | zzw | = | fst (findMax zzw) |
|
|
mkBranchLeft_size | zww zwx zwy | = | sizeFM zwy |
|
|
mkBranchResult | zwz zxu zxv zxw | = | Branch zwz zxu (mkBranchUnbox zxv zwz zxw (1 + mkBranchLeft_size zxv zwz zxw + mkBranchRight_size zxv zwz zxw)) zxw zxv |
|
|
mkBranchRight_ok | zww zwx zwy | = | mkBranchRight_ok0 zww zwx zwy zww zwx zww |
|
|
mkBranchRight_ok0 | zww zwx zwy fm_r key EmptyFM | = | True |
mkBranchRight_ok0 | zww zwx zwy fm_r key (Branch right_key wu wv ww wx) | = | key < mkBranchRight_ok0Smallest_right_key fm_r |
|
|
mkBranchRight_ok0Smallest_right_key | zzv | = | fst (findMin zzv) |
|
|
mkBranchRight_size | zww zwx zwy | = | sizeFM zww |
|
| mkBranchUnbox :: Ord a => -> (FiniteMap a b) ( -> a ( -> (FiniteMap a b) (Int -> Int)))
mkBranchUnbox | zww zwx zwy x | = | x |
|
| mkVBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkVBalBranch | key elt EmptyFM fm_r | = | mkVBalBranch5 key elt EmptyFM fm_r |
mkVBalBranch | key elt fm_l EmptyFM | = | mkVBalBranch4 key elt fm_l EmptyFM |
mkVBalBranch | key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) | = | mkVBalBranch3 key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) |
|
|
mkVBalBranch3 | key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) | = | mkVBalBranch3MkVBalBranch2 vuy vuz vvu vvv vvw vvy vvz vwu vwv vww key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww (sIZE_RATIO * mkVBalBranch3Size_l vuy vuz vvu vvv vvw vvy vvz vwu vwv vww < mkVBalBranch3Size_r vuy vuz vvu vvv vvw vvy vvz vwu vwv vww) |
|
|
mkVBalBranch3MkVBalBranch0 | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww True | = | mkBranch 13 key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) |
|
|
mkVBalBranch3MkVBalBranch1 | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww True | = | mkBalBranch vuy vuz vvv (mkVBalBranch key elt vvw (Branch vvy vvz vwu vwv vww)) |
mkVBalBranch3MkVBalBranch1 | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww False | = | mkVBalBranch3MkVBalBranch0 zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww otherwise |
|
|
mkVBalBranch3MkVBalBranch2 | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww True | = | mkBalBranch vvy vvz (mkVBalBranch key elt (Branch vuy vuz vvu vvv vvw) vwv) vww |
mkVBalBranch3MkVBalBranch2 | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww False | = | mkVBalBranch3MkVBalBranch1 zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww (sIZE_RATIO * mkVBalBranch3Size_r zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu < mkVBalBranch3Size_l zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu) |
|
|
mkVBalBranch3Size_l | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu | = | sizeFM (Branch zxx zxy zxz zyu zyv) |
|
|
mkVBalBranch3Size_r | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu | = | sizeFM (Branch zyw zyx zyy zyz zzu) |
|
|
mkVBalBranch4 | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch4 | xwy xwz xxu xxv | = | mkVBalBranch3 xwy xwz xxu xxv |
|
|
mkVBalBranch5 | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch5 | xxx xxy xxz xyu | = | mkVBalBranch4 xxx xxy xxz xyu |
|
| sIZE_RATIO :: Int
|
| sizeFM :: FiniteMap b a -> Int
sizeFM | EmptyFM | = | 0 |
sizeFM | (Branch xz yu size yv yw) | = | size |
|
| splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a
splitGT | EmptyFM split_key | = | splitGT4 EmptyFM split_key |
splitGT | (Branch key elt xy fm_l fm_r) split_key | = | splitGT3 (Branch key elt xy fm_l fm_r) split_key |
|
|
splitGT0 | key elt xy fm_l fm_r split_key True | = | fm_r |
|
|
splitGT1 | key elt xy fm_l fm_r split_key True | = | mkVBalBranch key elt (splitGT fm_l split_key) fm_r |
splitGT1 | key elt xy fm_l fm_r split_key False | = | splitGT0 key elt xy fm_l fm_r split_key otherwise |
|
|
splitGT2 | key elt xy fm_l fm_r split_key True | = | splitGT fm_r split_key |
splitGT2 | key elt xy fm_l fm_r split_key False | = | splitGT1 key elt xy fm_l fm_r split_key (split_key < key) |
|
|
splitGT3 | (Branch key elt xy fm_l fm_r) split_key | = | splitGT2 key elt xy fm_l fm_r split_key (split_key > key) |
|
|
splitGT4 | EmptyFM split_key | = | emptyFM |
splitGT4 | xux xuy | = | splitGT3 xux xuy |
|
| splitLT :: Ord b => FiniteMap b a -> b -> FiniteMap b a
splitLT | EmptyFM split_key | = | splitLT4 EmptyFM split_key |
splitLT | (Branch key elt xx fm_l fm_r) split_key | = | splitLT3 (Branch key elt xx fm_l fm_r) split_key |
|
|
splitLT0 | key elt xx fm_l fm_r split_key True | = | fm_l |
|
|
splitLT1 | key elt xx fm_l fm_r split_key True | = | mkVBalBranch key elt fm_l (splitLT fm_r split_key) |
splitLT1 | key elt xx fm_l fm_r split_key False | = | splitLT0 key elt xx fm_l fm_r split_key otherwise |
|
|
splitLT2 | key elt xx fm_l fm_r split_key True | = | splitLT fm_l split_key |
splitLT2 | key elt xx fm_l fm_r split_key False | = | splitLT1 key elt xx fm_l fm_r split_key (split_key > key) |
|
|
splitLT3 | (Branch key elt xx fm_l fm_r) split_key | = | splitLT2 key elt xx fm_l fm_r split_key (split_key < key) |
|
|
splitLT4 | EmptyFM split_key | = | emptyFM |
splitLT4 | wzz xuu | = | splitLT3 wzz xuu |
|
| unitFM :: b -> a -> FiniteMap b a
unitFM | key elt | = | Branch key elt 1 emptyFM emptyFM |
|
| import qualified Maybe import qualified Prelude
|
| data FiniteMap b a = EmptyFM | Branch b a Int (FiniteMap b a) (FiniteMap b a)
|
| instance (Eq a, Eq b) => Eq (FiniteMap a b) where
|
|
(==) | fm_1 fm_2 | = | sizeFM fm_1 == sizeFM fm_2 && fmToList fm_1 == fmToList fm_2 |
|
|
| addToFM :: Ord b => FiniteMap b a -> b -> a -> FiniteMap b a
addToFM | fm key elt | = | addToFM_C addToFM0 fm key elt |
|
|
|
| addToFM_C :: Ord a => (b -> b -> b) -> FiniteMap a b -> a -> b -> FiniteMap a b
addToFM_C | combiner EmptyFM key elt | = | addToFM_C4 combiner EmptyFM key elt |
addToFM_C | combiner (Branch key elt size fm_l fm_r) new_key new_elt | = | addToFM_C3 combiner (Branch key elt size fm_l fm_r) new_key new_elt |
|
|
addToFM_C0 | combiner key elt size fm_l fm_r new_key new_elt True | = | Branch new_key (combiner elt new_elt) size fm_l fm_r |
|
|
addToFM_C1 | combiner key elt size fm_l fm_r new_key new_elt True | = | mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) |
addToFM_C1 | combiner key elt size fm_l fm_r new_key new_elt False | = | addToFM_C0 combiner key elt size fm_l fm_r new_key new_elt otherwise |
|
|
addToFM_C2 | combiner key elt size fm_l fm_r new_key new_elt True | = | mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r |
addToFM_C2 | combiner key elt size fm_l fm_r new_key new_elt False | = | addToFM_C1 combiner key elt size fm_l fm_r new_key new_elt (new_key > key) |
|
|
addToFM_C3 | combiner (Branch key elt size fm_l fm_r) new_key new_elt | = | addToFM_C2 combiner key elt size fm_l fm_r new_key new_elt (new_key < key) |
|
|
addToFM_C4 | combiner EmptyFM key elt | = | unitFM key elt |
addToFM_C4 | xyz xzu xzv xzw | = | addToFM_C3 xyz xzu xzv xzw |
|
| deleteMax :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMax | (Branch key elt vwx fm_l EmptyFM) | = | fm_l |
deleteMax | (Branch key elt vwy fm_l fm_r) | = | mkBalBranch key elt fm_l (deleteMax fm_r) |
|
| deleteMin :: Ord a => FiniteMap a b -> FiniteMap a b
deleteMin | (Branch key elt wuw EmptyFM fm_r) | = | fm_r |
deleteMin | (Branch key elt wux fm_l fm_r) | = | mkBalBranch key elt (deleteMin fm_l) fm_r |
|
| emptyFM :: FiniteMap b a
|
| findMax :: FiniteMap a b -> (a,b)
findMax | (Branch key elt vyz vzu EmptyFM) | = | (key,elt) |
findMax | (Branch key elt vzv vzw fm_r) | = | findMax fm_r |
|
| findMin :: FiniteMap a b -> (a,b)
findMin | (Branch key elt wz EmptyFM xu) | = | (key,elt) |
findMin | (Branch key elt xv fm_l xw) | = | findMin fm_l |
|
| fmToList :: FiniteMap a b -> [(a,b)]
fmToList | fm | = | foldFM fmToList0 [] fm |
|
|
fmToList0 | key elt rest | = | (key,elt) : rest |
|
| foldFM :: (c -> b -> a -> a) -> a -> FiniteMap c b -> a
foldFM | k z EmptyFM | = | z |
foldFM | k z (Branch key elt wy fm_l fm_r) | = | foldFM k (k key elt (foldFM k z fm_r)) fm_l |
|
| glueBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueBal | EmptyFM fm2 | = | glueBal4 EmptyFM fm2 |
glueBal | fm1 EmptyFM | = | glueBal3 fm1 EmptyFM |
glueBal | fm1 fm2 | = | glueBal2 fm1 fm2 |
|
|
glueBal2 | fm1 fm2 | = | glueBal2GlueBal1 fm1 fm2 fm1 fm2 (sizeFM fm2 > sizeFM fm1) |
|
|
glueBal2GlueBal0 | yzy yzz fm1 fm2 True | = | mkBalBranch (glueBal2Mid_key1 yzy yzz) (glueBal2Mid_elt1 yzy yzz) (deleteMax fm1) fm2 |
|
|
glueBal2GlueBal1 | yzy yzz fm1 fm2 True | = | mkBalBranch (glueBal2Mid_key2 yzy yzz) (glueBal2Mid_elt2 yzy yzz) fm1 (deleteMin fm2) |
glueBal2GlueBal1 | yzy yzz fm1 fm2 False | = | glueBal2GlueBal0 yzy yzz fm1 fm2 otherwise |
|
|
glueBal2Mid_elt1 | yzy yzz | = | glueBal2Mid_elt10 yzy yzz (glueBal2Vv2 yzy yzz) |
|
|
glueBal2Mid_elt10 | yzy yzz (vzx,mid_elt1) | = | mid_elt1 |
|
|
glueBal2Mid_elt2 | yzy yzz | = | glueBal2Mid_elt20 yzy yzz (glueBal2Vv3 yzy yzz) |
|
|
glueBal2Mid_elt20 | yzy yzz (vzy,mid_elt2) | = | mid_elt2 |
|
|
glueBal2Mid_key1 | yzy yzz | = | glueBal2Mid_key10 yzy yzz (glueBal2Vv2 yzy yzz) |
|
|
glueBal2Mid_key10 | yzy yzz (mid_key1,vzz) | = | mid_key1 |
|
|
glueBal2Mid_key2 | yzy yzz | = | glueBal2Mid_key20 yzy yzz (glueBal2Vv3 yzy yzz) |
|
|
glueBal2Mid_key20 | yzy yzz (mid_key2,wuu) | = | mid_key2 |
|
|
glueBal2Vv2 | yzy yzz | = | findMax yzy |
|
|
glueBal2Vv3 | yzy yzz | = | findMin yzz |
|
|
glueBal3 | fm1 EmptyFM | = | fm1 |
glueBal3 | xzy xzz | = | glueBal2 xzy xzz |
|
|
glueBal4 | EmptyFM fm2 | = | fm2 |
glueBal4 | yuv yuw | = | glueBal3 yuv yuw |
|
| glueVBal :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b
glueVBal | EmptyFM fm2 | = | glueVBal5 EmptyFM fm2 |
glueVBal | fm1 EmptyFM | = | glueVBal4 fm1 EmptyFM |
glueVBal | (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) | = | glueVBal3 (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) |
|
|
glueVBal3 | (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) | = | glueVBal3GlueVBal2 yy yz zu zv zw zy zz vuu vuv vuw yy yz zu zv zw zy zz vuu vuv vuw (sIZE_RATIO * glueVBal3Size_l yy yz zu zv zw zy zz vuu vuv vuw < glueVBal3Size_r yy yz zu zv zw zy zz vuu vuv vuw) |
|
|
glueVBal3GlueVBal0 | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw True | = | glueBal (Branch yy yz zu zv zw) (Branch zy zz vuu vuv vuw) |
|
|
glueVBal3GlueVBal1 | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw True | = | mkBalBranch yy yz zv (glueVBal zw (Branch zy zz vuu vuv vuw)) |
glueVBal3GlueVBal1 | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw False | = | glueVBal3GlueVBal0 zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw otherwise |
|
|
glueVBal3GlueVBal2 | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw True | = | mkBalBranch zy zz (glueVBal (Branch yy yz zu zv zw) vuv) vuw |
glueVBal3GlueVBal2 | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw False | = | glueVBal3GlueVBal1 zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv yy yz zu zv zw zy zz vuu vuv vuw (sIZE_RATIO * glueVBal3Size_r zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv < glueVBal3Size_l zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv) |
|
|
glueVBal3Size_l | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv | = | sizeFM (Branch zuy zuz zvu zvv zvw) |
|
|
glueVBal3Size_r | zuy zuz zvu zvv zvw zvx zvy zvz zwu zwv | = | sizeFM (Branch zvx zvy zvz zwu zwv) |
|
|
glueVBal4 | fm1 EmptyFM | = | fm1 |
glueVBal4 | xvw xvx | = | glueVBal3 xvw xvx |
|
|
glueVBal5 | EmptyFM fm2 | = | fm2 |
glueVBal5 | xvz xwu | = | glueVBal4 xvz xwu |
|
| intersectFM_C :: Ord d => (a -> c -> b) -> FiniteMap d a -> FiniteMap d c -> FiniteMap d b
intersectFM_C | combiner fm1 EmptyFM | = | intersectFM_C4 combiner fm1 EmptyFM |
intersectFM_C | combiner EmptyFM fm2 | = | intersectFM_C3 combiner EmptyFM fm2 |
intersectFM_C | combiner fm1 (Branch split_key elt2 wuy left right) | = | intersectFM_C2 combiner fm1 (Branch split_key elt2 wuy left right) |
|
|
intersectFM_C2 | combiner fm1 (Branch split_key elt2 wuy left right) | = | intersectFM_C2IntersectFM_C1 fm1 split_key combiner fm1 split_key elt2 wuy left right (Maybe.isJust (intersectFM_C2Maybe_elt1 fm1 split_key)) |
|
|
intersectFM_C2Elt1 | yzw yzx | = | intersectFM_C2Elt10 yzw yzx (intersectFM_C2Vv1 yzw yzx) |
|
|
intersectFM_C2Elt10 | yzw yzx (Just elt1) | = | elt1 |
|
|
intersectFM_C2Gts | yzw yzx | = | splitGT yzw yzx |
|
|
intersectFM_C2IntersectFM_C0 | yzw yzx combiner fm1 split_key elt2 wuy left right True | = | glueVBal (intersectFM_C combiner (intersectFM_C2Lts yzw yzx) left) (intersectFM_C combiner (intersectFM_C2Gts yzw yzx) right) |
|
|
intersectFM_C2IntersectFM_C1 | yzw yzx combiner fm1 split_key elt2 wuy left right True | = | mkVBalBranch split_key (combiner (intersectFM_C2Elt1 yzw yzx) elt2) (intersectFM_C combiner (intersectFM_C2Lts yzw yzx) left) (intersectFM_C combiner (intersectFM_C2Gts yzw yzx) right) |
intersectFM_C2IntersectFM_C1 | yzw yzx combiner fm1 split_key elt2 wuy left right False | = | intersectFM_C2IntersectFM_C0 yzw yzx combiner fm1 split_key elt2 wuy left right otherwise |
|
|
intersectFM_C2Lts | yzw yzx | = | splitLT yzw yzx |
|
|
intersectFM_C2Maybe_elt1 | yzw yzx | = | lookupFM yzw yzx |
|
|
intersectFM_C2Vv1 | yzw yzx | = | intersectFM_C2Maybe_elt1 yzw yzx |
|
|
intersectFM_C3 | combiner EmptyFM fm2 | = | emptyFM |
intersectFM_C3 | yvx yvy yvz | = | intersectFM_C2 yvx yvy yvz |
|
|
intersectFM_C4 | combiner fm1 EmptyFM | = | emptyFM |
intersectFM_C4 | ywv yww ywx | = | intersectFM_C3 ywv yww ywx |
|
| lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b
lookupFM | EmptyFM key | = | lookupFM4 EmptyFM key |
lookupFM | (Branch key elt wuv fm_l fm_r) key_to_find | = | lookupFM3 (Branch key elt wuv fm_l fm_r) key_to_find |
|
|
lookupFM0 | key elt wuv fm_l fm_r key_to_find True | = | Just elt |
|
|
lookupFM1 | key elt wuv fm_l fm_r key_to_find True | = | lookupFM fm_r key_to_find |
lookupFM1 | key elt wuv fm_l fm_r key_to_find False | = | lookupFM0 key elt wuv fm_l fm_r key_to_find otherwise |
|
|
lookupFM2 | key elt wuv fm_l fm_r key_to_find True | = | lookupFM fm_l key_to_find |
lookupFM2 | key elt wuv fm_l fm_r key_to_find False | = | lookupFM1 key elt wuv fm_l fm_r key_to_find (key_to_find > key) |
|
|
lookupFM3 | (Branch key elt wuv fm_l fm_r) key_to_find | = | lookupFM2 key elt wuv fm_l fm_r key_to_find (key_to_find < key) |
|
|
lookupFM4 | EmptyFM key | = | Nothing |
lookupFM4 | yuz yvu | = | lookupFM3 yuz yvu |
|
| mkBalBranch :: Ord b => b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBalBranch | key elt fm_L fm_R | = | mkBalBranch6 key elt fm_L fm_R |
|
|
mkBalBranch6 | key elt fm_L fm_R | = | mkBalBranch6MkBalBranch5 key elt fm_L fm_R key elt fm_L fm_R (mkBalBranch6Size_l key elt fm_L fm_R + mkBalBranch6Size_r key elt fm_L fm_R < Pos (Succ (Succ Zero))) |
|
|
mkBalBranch6Double_L | zuu zuv zuw zux fm_l (Branch key_r elt_r vxz (Branch key_rl elt_rl vyu fm_rll fm_rlr) fm_rr) | = | mkBranch (Pos (Succ (Succ (Succ (Succ (Succ Zero)))))) key_rl elt_rl (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))) zuu zuv fm_l fm_rll) (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))) key_r elt_r fm_rlr fm_rr) |
|
|
mkBalBranch6Double_R | zuu zuv zuw zux (Branch key_l elt_l vxu fm_ll (Branch key_lr elt_lr vxv fm_lrl fm_lrr)) fm_r | = | mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))))))) key_lr elt_lr (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))))))) key_l elt_l fm_ll fm_lrl) (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))))))))) zuu zuv fm_lrr fm_r) |
|
|
mkBalBranch6MkBalBranch0 | zuu zuv zuw zux fm_L fm_R (Branch vyv vyw vyx fm_rl fm_rr) | = | mkBalBranch6MkBalBranch02 zuu zuv zuw zux fm_L fm_R (Branch vyv vyw vyx fm_rl fm_rr) |
|
|
mkBalBranch6MkBalBranch00 | zuu zuv zuw zux fm_L fm_R vyv vyw vyx fm_rl fm_rr True | = | mkBalBranch6Double_L zuu zuv zuw zux fm_L fm_R |
|
|
mkBalBranch6MkBalBranch01 | zuu zuv zuw zux fm_L fm_R vyv vyw vyx fm_rl fm_rr True | = | mkBalBranch6Single_L zuu zuv zuw zux fm_L fm_R |
mkBalBranch6MkBalBranch01 | zuu zuv zuw zux fm_L fm_R vyv vyw vyx fm_rl fm_rr False | = | mkBalBranch6MkBalBranch00 zuu zuv zuw zux fm_L fm_R vyv vyw vyx fm_rl fm_rr otherwise |
|
|
mkBalBranch6MkBalBranch02 | zuu zuv zuw zux fm_L fm_R (Branch vyv vyw vyx fm_rl fm_rr) | = | mkBalBranch6MkBalBranch01 zuu zuv zuw zux fm_L fm_R vyv vyw vyx fm_rl fm_rr (sizeFM fm_rl < Pos (Succ (Succ Zero)) * sizeFM fm_rr) |
|
|
mkBalBranch6MkBalBranch1 | zuu zuv zuw zux fm_L fm_R (Branch vxw vxx vxy fm_ll fm_lr) | = | mkBalBranch6MkBalBranch12 zuu zuv zuw zux fm_L fm_R (Branch vxw vxx vxy fm_ll fm_lr) |
|
|
mkBalBranch6MkBalBranch10 | zuu zuv zuw zux fm_L fm_R vxw vxx vxy fm_ll fm_lr True | = | mkBalBranch6Double_R zuu zuv zuw zux fm_L fm_R |
|
|
mkBalBranch6MkBalBranch11 | zuu zuv zuw zux fm_L fm_R vxw vxx vxy fm_ll fm_lr True | = | mkBalBranch6Single_R zuu zuv zuw zux fm_L fm_R |
mkBalBranch6MkBalBranch11 | zuu zuv zuw zux fm_L fm_R vxw vxx vxy fm_ll fm_lr False | = | mkBalBranch6MkBalBranch10 zuu zuv zuw zux fm_L fm_R vxw vxx vxy fm_ll fm_lr otherwise |
|
|
mkBalBranch6MkBalBranch12 | zuu zuv zuw zux fm_L fm_R (Branch vxw vxx vxy fm_ll fm_lr) | = | mkBalBranch6MkBalBranch11 zuu zuv zuw zux fm_L fm_R vxw vxx vxy fm_ll fm_lr (sizeFM fm_lr < Pos (Succ (Succ Zero)) * sizeFM fm_ll) |
|
|
mkBalBranch6MkBalBranch2 | zuu zuv zuw zux key elt fm_L fm_R True | = | mkBranch (Pos (Succ (Succ Zero))) key elt fm_L fm_R |
|
|
mkBalBranch6MkBalBranch3 | zuu zuv zuw zux key elt fm_L fm_R True | = | mkBalBranch6MkBalBranch1 zuu zuv zuw zux fm_L fm_R fm_L |
mkBalBranch6MkBalBranch3 | zuu zuv zuw zux key elt fm_L fm_R False | = | mkBalBranch6MkBalBranch2 zuu zuv zuw zux key elt fm_L fm_R otherwise |
|
|
mkBalBranch6MkBalBranch4 | zuu zuv zuw zux key elt fm_L fm_R True | = | mkBalBranch6MkBalBranch0 zuu zuv zuw zux fm_L fm_R fm_R |
mkBalBranch6MkBalBranch4 | zuu zuv zuw zux key elt fm_L fm_R False | = | mkBalBranch6MkBalBranch3 zuu zuv zuw zux key elt fm_L fm_R (mkBalBranch6Size_l zuu zuv zuw zux > sIZE_RATIO * mkBalBranch6Size_r zuu zuv zuw zux) |
|
|
mkBalBranch6MkBalBranch5 | zuu zuv zuw zux key elt fm_L fm_R True | = | mkBranch (Pos (Succ Zero)) key elt fm_L fm_R |
mkBalBranch6MkBalBranch5 | zuu zuv zuw zux key elt fm_L fm_R False | = | mkBalBranch6MkBalBranch4 zuu zuv zuw zux key elt fm_L fm_R (mkBalBranch6Size_r zuu zuv zuw zux > sIZE_RATIO * mkBalBranch6Size_l zuu zuv zuw zux) |
|
|
mkBalBranch6Single_L | zuu zuv zuw zux fm_l (Branch key_r elt_r vyy fm_rl fm_rr) | = | mkBranch (Pos (Succ (Succ (Succ Zero)))) key_r elt_r (mkBranch (Pos (Succ (Succ (Succ (Succ Zero))))) zuu zuv fm_l fm_rl) fm_rr |
|
|
mkBalBranch6Single_R | zuu zuv zuw zux (Branch key_l elt_l vwz fm_ll fm_lr) fm_r | = | mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero))))))))) key_l elt_l fm_ll (mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))))) zuu zuv fm_lr fm_r) |
|
|
mkBalBranch6Size_l | zuu zuv zuw zux | = | sizeFM zuw |
|
|
mkBalBranch6Size_r | zuu zuv zuw zux | = | sizeFM zux |
|
| mkBranch :: Ord b => Int -> b -> a -> FiniteMap b a -> FiniteMap b a -> FiniteMap b a
mkBranch | which key elt fm_l fm_r | = | mkBranchResult key elt fm_r fm_l |
|
|
mkBranchBalance_ok | zww zwx zwy | = | True |
|
|
mkBranchLeft_ok | zww zwx zwy | = | mkBranchLeft_ok0 zww zwx zwy zwy zwx zwy |
|
|
mkBranchLeft_ok0 | zww zwx zwy fm_l key EmptyFM | = | True |
mkBranchLeft_ok0 | zww zwx zwy fm_l key (Branch left_key vw vx vy vz) | = | mkBranchLeft_ok0Biggest_left_key fm_l < key |
|
|
mkBranchLeft_ok0Biggest_left_key | zzw | = | fst (findMax zzw) |
|
|
mkBranchLeft_size | zww zwx zwy | = | sizeFM zwy |
|
|
mkBranchResult | zwz zxu zxv zxw | = | Branch zwz zxu (mkBranchUnbox zxv zwz zxw (Pos (Succ Zero) + mkBranchLeft_size zxv zwz zxw + mkBranchRight_size zxv zwz zxw)) zxw zxv |
|
|
mkBranchRight_ok | zww zwx zwy | = | mkBranchRight_ok0 zww zwx zwy zww zwx zww |
|
|
mkBranchRight_ok0 | zww zwx zwy fm_r key EmptyFM | = | True |
mkBranchRight_ok0 | zww zwx zwy fm_r key (Branch right_key wu wv ww wx) | = | key < mkBranchRight_ok0Smallest_right_key fm_r |
|
|
mkBranchRight_ok0Smallest_right_key | zzv | = | fst (findMin zzv) |
|
|
mkBranchRight_size | zww zwx zwy | = | sizeFM zww |
|
| mkBranchUnbox :: Ord a => -> (FiniteMap a b) ( -> a ( -> (FiniteMap a b) (Int -> Int)))
mkBranchUnbox | zww zwx zwy x | = | x |
|
| mkVBalBranch :: Ord a => a -> b -> FiniteMap a b -> FiniteMap a b -> FiniteMap a b
mkVBalBranch | key elt EmptyFM fm_r | = | mkVBalBranch5 key elt EmptyFM fm_r |
mkVBalBranch | key elt fm_l EmptyFM | = | mkVBalBranch4 key elt fm_l EmptyFM |
mkVBalBranch | key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) | = | mkVBalBranch3 key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) |
|
|
mkVBalBranch3 | key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) | = | mkVBalBranch3MkVBalBranch2 vuy vuz vvu vvv vvw vvy vvz vwu vwv vww key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww (sIZE_RATIO * mkVBalBranch3Size_l vuy vuz vvu vvv vvw vvy vvz vwu vwv vww < mkVBalBranch3Size_r vuy vuz vvu vvv vvw vvy vvz vwu vwv vww) |
|
|
mkVBalBranch3MkVBalBranch0 | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww True | = | mkBranch (Pos (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))))))))))) key elt (Branch vuy vuz vvu vvv vvw) (Branch vvy vvz vwu vwv vww) |
|
|
mkVBalBranch3MkVBalBranch1 | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww True | = | mkBalBranch vuy vuz vvv (mkVBalBranch key elt vvw (Branch vvy vvz vwu vwv vww)) |
mkVBalBranch3MkVBalBranch1 | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww False | = | mkVBalBranch3MkVBalBranch0 zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww otherwise |
|
|
mkVBalBranch3MkVBalBranch2 | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww True | = | mkBalBranch vvy vvz (mkVBalBranch key elt (Branch vuy vuz vvu vvv vvw) vwv) vww |
mkVBalBranch3MkVBalBranch2 | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww False | = | mkVBalBranch3MkVBalBranch1 zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu key elt vuy vuz vvu vvv vvw vvy vvz vwu vwv vww (sIZE_RATIO * mkVBalBranch3Size_r zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu < mkVBalBranch3Size_l zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu) |
|
|
mkVBalBranch3Size_l | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu | = | sizeFM (Branch zxx zxy zxz zyu zyv) |
|
|
mkVBalBranch3Size_r | zxx zxy zxz zyu zyv zyw zyx zyy zyz zzu | = | sizeFM (Branch zyw zyx zyy zyz zzu) |
|
|
mkVBalBranch4 | key elt fm_l EmptyFM | = | addToFM fm_l key elt |
mkVBalBranch4 | xwy xwz xxu xxv | = | mkVBalBranch3 xwy xwz xxu xxv |
|
|
mkVBalBranch5 | key elt EmptyFM fm_r | = | addToFM fm_r key elt |
mkVBalBranch5 | xxx xxy xxz xyu | = | mkVBalBranch4 xxx xxy xxz xyu |
|
| sIZE_RATIO :: Int
sIZE_RATIO | | = | Pos (Succ (Succ (Succ (Succ (Succ Zero))))) |
|
| sizeFM :: FiniteMap a b -> Int
sizeFM | EmptyFM | = | Pos Zero |
sizeFM | (Branch xz yu size yv yw) | = | size |
|
| splitGT :: Ord b => FiniteMap b a -> b -> FiniteMap b a
splitGT | EmptyFM split_key | = | splitGT4 EmptyFM split_key |
splitGT | (Branch key elt xy fm_l fm_r) split_key | = | splitGT3 (Branch key elt xy fm_l fm_r) split_key |
|
|
splitGT0 | key elt xy fm_l fm_r split_key True | = | fm_r |
|
|
splitGT1 | key elt xy fm_l fm_r split_key True | = | mkVBalBranch key elt (splitGT fm_l split_key) fm_r |
splitGT1 | key elt xy fm_l fm_r split_key False | = | splitGT0 key elt xy fm_l fm_r split_key otherwise |
|
|
splitGT2 | key elt xy fm_l fm_r split_key True | = | splitGT fm_r split_key |
splitGT2 | key elt xy fm_l fm_r split_key False | = | splitGT1 key elt xy fm_l fm_r split_key (split_key < key) |
|
|
splitGT3 | (Branch key elt xy fm_l fm_r) split_key | = | splitGT2 key elt xy fm_l fm_r split_key (split_key > key) |
|
|
splitGT4 | EmptyFM split_key | = | emptyFM |
splitGT4 | xux xuy | = | splitGT3 xux xuy |
|
| splitLT :: Ord a => FiniteMap a b -> a -> FiniteMap a b
splitLT | EmptyFM split_key | = | splitLT4 EmptyFM split_key |
splitLT | (Branch key elt xx fm_l fm_r) split_key | = | splitLT3 (Branch key elt xx fm_l fm_r) split_key |
|
|
splitLT0 | key elt xx fm_l fm_r split_key True | = | fm_l |
|
|
splitLT1 | key elt xx fm_l fm_r split_key True | = | mkVBalBranch key elt fm_l (splitLT fm_r split_key) |
splitLT1 | key elt xx fm_l fm_r split_key False | = | splitLT0 key elt xx fm_l fm_r split_key otherwise |
|
|
splitLT2 | key elt xx fm_l fm_r split_key True | = | splitLT fm_l split_key |
splitLT2 | key elt xx fm_l fm_r split_key False | = | splitLT1 key elt xx fm_l fm_r split_key (split_key > key) |
|
|
splitLT3 | (Branch key elt xx fm_l fm_r) split_key | = | splitLT2 key elt xx fm_l fm_r split_key (split_key < key) |
|
|
splitLT4 | EmptyFM split_key | = | emptyFM |
splitLT4 | wzz xuu | = | splitLT3 wzz xuu |
|
| unitFM :: a -> b -> FiniteMap a b
unitFM | key elt | = | Branch key elt (Pos (Succ Zero)) emptyFM emptyFM |
|